home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr50 / s3bas11.zip / CHGMOD.BAS next >
BASIC Source File  |  1993-05-14  |  14KB  |  348 lines
  1. '*************************************************
  2. '* This example is for reading/setting file      *
  3. '* attributes.  It also is an example of how     *
  4. '* to read file names from the disk.  BC 7.1     *
  5. '* and VB DOS all support the DIR$ function,     *
  6. '* but QB does not, so we will low-level code    *
  7. '* our own DIR function and call it READDIR      *
  8. '*                                               *
  9. '* This code is the copyright of George Spafford *
  10. '*                                               *
  11. '* v1.0  04/29/93  Initial Release               *
  12. '*************************************************
  13. 'We use interrupt 21H and the following functions:
  14. '
  15. '   1AH                : Set DTA address
  16. '   43H, Subfunction 1 : Set file attributes
  17. '   4EH                : Find first matching file
  18. '   4FH                : Find the next matching file
  19. '
  20. '===================================================
  21.  
  22. DEFINT A-Z             'make variables integer by default
  23.  
  24. TYPE RegType
  25.      AX    AS INTEGER
  26.      bx    AS INTEGER
  27.      CX    AS INTEGER
  28.      DX    AS INTEGER
  29.      bp    AS INTEGER
  30.      si    AS INTEGER
  31.      di    AS INTEGER
  32.      Flags AS INTEGER
  33. END TYPE
  34.  
  35. TYPE RegTypeX
  36.      AX    AS INTEGER
  37.      bx    AS INTEGER
  38.      CX    AS INTEGER
  39.      DX    AS INTEGER
  40.      bp    AS INTEGER
  41.      si    AS INTEGER
  42.      di    AS INTEGER
  43.      Flags AS INTEGER
  44.      DS    AS INTEGER
  45.      es    AS INTEGER
  46. END TYPE
  47.  
  48. TYPE F
  49.      Buffer AS STRING * 21  'reserved for DOS
  50.      Attrib AS STRING * 1   'file attribute
  51.      Time   AS INTEGER      'file time
  52.      Date   AS INTEGER      'file date
  53.      Size   AS LONG         'file size
  54.      Name   AS STRING * 13  'file name (12 + CHR$(0))
  55. END TYPE
  56.  
  57. DIM Arg$(10)                'holds command arguments
  58. DIM Finfo AS F              'holds located file info
  59. DIM InRegs  AS RegType      'use InReg to hold all registers
  60.                             'except segment registers
  61. DIM OutRegs AS RegType      'Use OutReg to receive values
  62. DIM InRegsX  AS RegTypeX    'use InReg to hold all registers
  63.                             'including segment registers
  64. DIM OutRegsX AS RegTypeX    'Use OutReg to receive values
  65.  
  66. DECLARE SUB INTERRUPT (intnum AS INTEGER, InReg AS RegType, OutReg AS RegType)
  67. DECLARE SUB InterruptX (intnum AS INTEGER, InReg AS RegTypeX, OutReg AS RegTypeX)
  68.  
  69.  
  70. '******** End of Declarations ********
  71.  
  72. Title$ = "S3 CHGMOD v1.0              Copyright George Spafford 04/29/93"
  73. PRINT
  74. PRINT Title$
  75. PRINT
  76. PRINT "Name", "Size", "Previous", "New"
  77. PRINT
  78.  
  79. 'The next line ensures that the COMMAND line is
  80. 'upper case and that left and right spaces are
  81. 'stripped.  The normal libraries usually do this
  82. 'for you, but some libraries (Crescent's PDQ) do
  83. 'not provide the same support.
  84.  
  85. CL$ = LTRIM$(RTRIM$(UCASE$(COMMAND$)))
  86.  
  87. IF CL$ = "" THEN GOTO CLHelp             'can not be NULL
  88. IF INSTR(CL$, "?") > 0 THEN GOTO CLHelp  'they want help!
  89.  
  90. 'okay, we now need to parse the command line for the
  91. 'proper elements.  I am going to use white-space (just
  92. 'a space) as the separator (delimitter) between
  93. 'commands and recognize the "/" as indicative of a
  94. 'switch.  One space will be added to the end of the
  95. 'command line to serve as the final delimitter.
  96.  
  97. CL$ = CL$ + " "
  98.  
  99. Start = 1                           'Byte to begin the parse at
  100. Look = 1                            'where INSTR should start looking
  101.                                     'for spaces
  102. DO                                  'DO loop
  103.    a = INSTR(Look, CL$, " ")        'store position of space found
  104.                                     'after byte specified as Look
  105.    IF a > 0 THEN                    'Did INSTR find a space?
  106.       CFound = CFound + 1           'if so, add one to array counter
  107.       Length = (a - Start)          'this is how long the argument is
  108.       Arg$(CFound) = MID$(CL$, Start, Length)   'This just uses MID$ to grab it
  109.       Start = a + 1                 'New start is A + 1
  110.       Look = Start + 1              'INSTR needs to look for spaces one
  111.                                     'byte further than where Start is
  112.    END IF                           'end block if
  113. LOOP UNTIL a = LEN(CL$)             'LOOP until A = the length of our command
  114.                                     'line.  This condition will be true when
  115.                                     'it processes the final space that we added
  116.  
  117. 'Okay, now we have all of the arguments loaded in the ARG$() array.
  118. 'Here, you could test for the number of arguments found if you wanted
  119. 'to force the user to enter a certain number of them.  For example:
  120. '       IF CFound < 2 then
  121. '          Print "ERROR:  Usage is:  CHGMOD filename [/R+][/R-] ..."
  122. '          Print
  123. '          end
  124. '       end if
  125. 'We will not do this here, because if the user does not enter anything on the
  126. 'command line, then we capture the condition with IF CL$="" THEN earlier.
  127. 'Also, if the user just enters the file name(s), we will display the current
  128. 'attributes assigned to that file(s).
  129.  
  130. IF CFound > 1 THEN                      'more that one arg?
  131.    FOR N = 2 TO CFound                  'start with #2
  132.        SELECT CASE Arg$(N)              'CASE check it
  133.               CASE "/R+"                'set read only
  134.                    SetReadOnly = 1
  135.               CASE "/R-"                'remove RO
  136.                    SetReadOnly = -1
  137.               CASE "/S+"                'set system
  138.                    SetSystem = 1
  139.               CASE "/S-"                'remove system
  140.                    SetSystem = -1
  141.               CASE "/H+"                'set hidden
  142.                    SetHidden = 1
  143.               CASE "/H-"                'remove hidden
  144.                    SetHidden = -1
  145.               CASE "/A+"                'set archive
  146.                    SetArchive = 1
  147.               CASE "/A-"                'remove archive
  148.                    SetArchive = -1
  149.               CASE "/-"                 'remove all
  150.                    Noattributes = 1
  151.               CASE ELSE                 'if none of the above
  152.                    GOTO CLHelp          'goto command help
  153.        END SELECT                       'end the CASE
  154.     NEXT N                              'process next argument
  155. END IF                                  'end the block if
  156.  
  157. 'Now, we get down to the hard core stuff.  Note, there are two ways
  158. 'to get directory entries.  The one NOT to use is INT 21H Function 11H.
  159. 'This uses the old File Control Blocks (FCB) and only operates in the
  160. 'current directory.  Function 11H does the initial match and 12H finds the
  161. 'next match.
  162. 'The method to use is INT 21H, Function 4EH and Function 4FH.
  163. 'This method makes use of handles and the Data Transfer Area (DTA).
  164. 'The DTA is an area in memory that stores the located file's
  165. 'attributes, file time, file date and file size.  When combined,
  166. 'this information uses the first 43 bytes of the DTA.
  167.  
  168. 'First, we need to set the DTA address.
  169. InRegsX.AX = &H1A00                     'Load AH with 1A
  170. InRegsX.DS = VARSEG(Finfo)              'Load the segment address
  171.                                         'to the DTA block into DS
  172. InRegsX.DX = VARPTR(Finfo)              'Load the offset address to
  173.                                         'the DTA block into DX
  174.  
  175. CALL InterruptX(&H21, InRegsX, OutRegsX)    'make the call
  176.  
  177. DIM Hold AS STRING * 65                 'assign a 64 + 1 byte buffer
  178.                                         'this means 64 bytes data + 1 CHR$(0)
  179. Hold = Arg$(1) + CHR$(0)                'File Name ended with ASCII 0
  180.                                         'do not forget to add the CHR$(0) !!!!
  181.                                         'The file name can contain wildcards.
  182. InRegsX.AX = &H4E00                     'Function 4EH into AH
  183. InRegsX.CX = 1 + 2 + 4 + 32             'Find matches of:
  184.                                         'bit 0:  Read Only
  185.                                         '    1:  Hidden
  186.                                         '    2:  System
  187.                                         '    5:  Archive
  188.                                         'essentially, CX holds a attribute
  189.                                         'that is used as a match as well as
  190.                                         'the file specification.
  191. InRegsX.DS = VARSEG(Hold)               'point to segment of HOLD$
  192. InRegsX.DX = VARPTR(Hold)               'point to offset of HOLD$
  193.  
  194. 'SPECIAL NOTE:  Since BASIC can move strings around, determine the Segment and
  195. '               offsets right before you use them.
  196.  
  197. CALL InterruptX(&H21, InRegsX, OutRegsX)
  198. IF OutRegsX.Flags AND 1 THEN            'If bit 0 is on, the carry flag is
  199.                                         'set which means an error occurred.
  200.  
  201.    IF OutRegsX.AX = 2 THEN              '2 means a path error
  202.       PRINT "Path Not Found"            '18 means not attributes matched.
  203.                                         'We will skip 18.
  204.    END IF
  205.    PRINT "No Files match:  "; FileSpec$
  206.    PRINT
  207.    END                                  'end if none are found
  208. END IF
  209.  
  210. 'If we make it to this point, we must assume that there exists
  211. 'either a single match or multiple matches to the file specification
  212. 'that we entered.
  213.  
  214. DO
  215.    Found = Found + 1                    'add one to the number of files found
  216.    attr = ASC(Finfo.Attrib)
  217.    Current$ = ""
  218.    RO = 0
  219.    Hidden = 0
  220.    SystemA = 0
  221.    Archive = 0
  222.             
  223.                                         'bit   attr
  224.    IF attr AND 1 THEN                   ' 0    Read-Only
  225.       RO = 1
  226.       Current$ = Current$ + "R"
  227.    END IF
  228.    IF attr AND 2 THEN                   ' 1    Hidden
  229.       Hidden = 2
  230.       Current$ = Current$ + "H"
  231.    END IF
  232.    IF attr AND 4 THEN                   ' 2    System
  233.       SystemA = 4
  234.       Current$ = Current$ + "S"
  235.    END IF
  236.    IF attr AND 32 THEN                  ' 5    Archive
  237.       Archive = 32
  238.       Current$ = Current$ + "A"
  239.    END IF
  240.    
  241.    a = INSTR(Finfo.Name, CHR$(0))       'find the CHR$(0)
  242.                                         'the next line pulls it out
  243.    IF a > 0 THEN Out$ = LEFT$(Finfo.Name, (a - 1))
  244.  
  245.    IF CFound > 1 THEN
  246.       IF SetReadOnly = 1 THEN RO = 1
  247.       IF SetReadOnly = -1 THEN RO = 0
  248.       IF SetHidden = 1 THEN Hidden = 2
  249.       IF SetHidden = -1 THEN Hidden = 0
  250.       IF SetSystem = 1 THEN SystemA = 4
  251.       IF SetSystem = -1 THEN SystemA = 0
  252.       IF SetArchive = 1 THEN Archive = 32
  253.       IF SetArchive = -1 THEN Archive = 0
  254.  
  255.       'Remember, remember, remember, we are setting bits
  256.       'here that have a corresponding integer depiction.
  257.       'Thus, we add them together.
  258.  
  259.       NewAttrib = RO + Hidden + SystemA + Archive
  260.       
  261.       IF Noattributes THEN NewAttrib = 0
  262.  
  263.       'Lets set the new attributes
  264.  
  265.       InRegsX.AX = &H43 * 256           'load 43H into AH
  266.       InRegsX.AX = InRegsX.AX OR &H1    'load 1H into AL
  267.  
  268.       'Let me explain the previous two lines a bit better.
  269.       'First, we loaded &H43 into AH by multiplying it by 256.
  270.       'Remember?  AX is a 16 bit register that is made up of two"
  271.       '8-bit registers that can be accessed independently.  Frankly,"
  272.       'I think we should have been given direct access to the 8-bit"
  273.       'registers, but we do not.
  274.       'Load AH first and then load AL by using the OR operator"
  275.       'Using OR will not destroy the value in AH.  If you are
  276.       'still scratching your head as to why we multiplied the
  277.       '43H by 256 it is because 8 enabled bits = 256.  Look in the
  278.       'print tutorial .DOC file for a good explanation.
  279.  
  280.       InRegsX.CX = NewAttrib
  281.       InRegsX.DS = VARSEG(Finfo.Name)
  282.       InRegsX.DX = VARPTR(Finfo.Name)
  283.       CALL InterruptX(&H21, InRegsX, OutRegsX)
  284.       IF OutRegsX.Flags AND 1 THEN
  285.          PRINT Out$, Finfo.Size, Current$
  286.          IF AX = 1 THEN PRINT "Unknown function code"
  287.          IF AX = 5 THEN PRINT "Attribute can not be changed"
  288.          PRINT
  289.          END
  290.       END IF
  291.    END IF
  292.    New$ = ""
  293.    IF RO THEN New$ = New$ + "R"
  294.    IF Hidden THEN New$ = New$ + "H"
  295.    IF SystemA THEN New$ = New$ + "S"
  296.    IF Archive THEN New$ = New$ + "A"
  297.    
  298.    IF Noattributes THEN New$ = ""
  299.  
  300.    PRINT Out$, Finfo.Size, Current$, New$
  301.  
  302.    'Next we look for the next matching file using function 4F.
  303.    'If we get an error in the Carry flag bit, we will assume that
  304.    'we have read in all of the matching file names.
  305.  
  306.    InRegsX.AX = &H4F00                  'load AH with 4F
  307.    CALL InterruptX(&H21, InRegsX, OutRegsX)
  308.    IF OutRegsX.Flags AND 1 THEN         'look for error
  309.       EndMatch = 1
  310.    END IF
  311. LOOP UNTIL EndMatch                     'if endmatch, then exit the loop
  312.  
  313. 'If we have found all of our matches, it is time to go bye-bye.
  314.  
  315. END
  316.  
  317.  
  318. 'The next fragment is just typical of how I do my command line help.
  319. 'In 99.9% of my programs, if the user does not enter any parameters,
  320. 'enters an unknown parameter, or a "?" on the command line, then I throw
  321. 'them into a small code segment that explains how to run the program.
  322.  
  323. CLHelp:
  324.     CLS
  325.     PRINT Title$
  326.     PRINT
  327.     PRINT "USAGE:  CHGMOD filename [/R+][/R-][/H+][/H-][/S+][/S-][/A+][/A-]"
  328.     PRINT
  329.     PRINT "               filename  <- this is the file specification that you"
  330.     PRINT "                            either wish to view or change"
  331.     PRINT ""
  332.     PRINT "               [/letter + or -]"
  333.     PRINT "                 R   =  Read-Only"
  334.     PRINT "                 H   =  Hidden"
  335.     PRINT "                 S   =  System"
  336.     PRINT "                 A   =  Archive"
  337.     PRINT "                 +   =  adds the attribute to the file(s)"
  338.     PRINT "                 -   =  removes the attribute from the file(s)"
  339.     PRINT
  340.     PRINT "Have a thrilling day"
  341.     END
  342.  
  343.         
  344.  
  345.  
  346.  
  347.  
  348.